home *** CD-ROM | disk | FTP | other *** search
/ PC World 2007 March / PCWorld_2007-03_cd.bin / domacnost a kancelar / scribus / scribus-1.3.3.7-win32-install.exe / tcl / tix8.1 / PanedWin.tcl < prev    next >
Text File  |  2001-11-03  |  29KB  |  1,215 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: PanedWin.tcl,v 1.4.2.1 2001/11/03 07:48:00 idiscovery Exp $
  4. #
  5. # PanedWin.tcl --
  6. #
  7. #    This file implements the TixPanedWindow widget
  8. #
  9. # Copyright (c) 1993-1999 Ioi Kim Lam.
  10. # Copyright (c) 2000-2001 Tix Project Group.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15.  
  16.  
  17. tixWidgetClass tixPanedWindow {
  18.     -classname TixPanedWindow
  19.     -superclass tixPrimitive
  20.     -method {
  21.     add delete forget manage panecget paneconfigure panes setsize
  22.     }
  23.     -flag {
  24.     -command -dynamicgeometry -handleactivebg -handlebg -orient
  25.     -orientation -panebd -paneborderwidth -panerelief
  26.     -separatoractivebg -separatorbg
  27.     }
  28.     -static {
  29.     -orientation
  30.     }
  31.     -configspec {
  32.     {-command command Command ""}
  33.     {-dynamicgeometry dynamicGeometry DynamicGeometry 1 tixVerifyBoolean}
  34.     {-handleactivebg handleActiveBg HandleActiveBg #ececec}
  35.     {-handlebg handleBg Background #d9d9d9}
  36.     {-orientation orientation Orientation vertical}
  37.     {-paneborderwidth paneBorderWidth PaneBorderWidth 1}
  38.     {-panerelief paneRelief PaneRelief raised}
  39.     {-separatoractivebg separatorActiveBg SeparatorActiveBg red}
  40.     {-separatorbg separatorBg Background #d9d9d9}
  41.     }
  42.     -alias {
  43.     {-panebd -paneborderwidth}
  44.     {-orient -orientation}
  45.     }
  46. }
  47.  
  48. #----------------------------------------------------------------------
  49. # ClassInitialization:
  50. #----------------------------------------------------------------------
  51.  
  52. proc tixPanedWindow:InitWidgetRec {w} {
  53.     upvar #0 $w data
  54.  
  55.     tixChainMethod $w InitWidgetRec
  56.  
  57.     set data(items)       ""
  58.     set data(nItems)      0
  59.     set data(totalsize)   0
  60.     set data(movePending) 0
  61.  
  62.     set data(repack)      0
  63.     set data(counter)     0
  64.  
  65.     set data(maxReqW)     1
  66.     set data(maxReqH)     1
  67. }
  68.  
  69. proc tixPanedWindow:ConstructWidget {w} {
  70.     upvar #0 $w data
  71.  
  72.     tixChainMethod $w ConstructWidget
  73.     # Do nothing
  74. }
  75.  
  76. proc tixPanedWindow:SetBindings {w} {
  77.     upvar #0 $w data
  78.  
  79.     tixChainMethod $w SetBindings
  80.  
  81.     bind $w <Configure> [list tixPanedWindow:MasterGeomProc $w ""]
  82. }
  83.  
  84. #----------------------------------------------------------------------
  85. # ConfigOptions:
  86. #----------------------------------------------------------------------
  87. proc tixPanedWindow:config-handlebg {w arg} {
  88.     upvar #0 $w data
  89.  
  90.     for {set i 1} {$i < $data(nItems)} {incr i} {
  91.     $data(btn,$i) config -bg $arg
  92.     }
  93. }
  94.  
  95. #----------------------------------------------------------------------
  96. # PublicMethods:
  97. #----------------------------------------------------------------------
  98.  
  99.  
  100. # method: add
  101. #
  102. #    Adds a new pane into the PanedWindow.
  103. #
  104. # options -size -max -min -allowresize
  105. #
  106. proc tixPanedWindow:add {w name args} {
  107.     upvar #0 $w data
  108.  
  109.     if {[winfo exists $w.$name] && !$data($name,forgotten)} {
  110.     error "Pane $name is already managed"
  111.     }
  112.     # Step 1: Parse the options to get the children's size options
  113.  
  114.     # The default values
  115.     #
  116.     if {[info exists data($name,forgotten)]} {
  117.     set option(-size)        $data($name,size)
  118.     set option(-min)         $data($name,min)
  119.     set option(-max)         $data($name,max)
  120.     set option(-allowresize) $data($name,allowresize)
  121.     set option(-expand)      $data($name,expand)
  122.     } else {
  123.     set option(-size)        0
  124.     set option(-min)         0
  125.     set option(-max)         100000
  126.     set option(-allowresize) 1
  127.     set option(-expand)      0
  128.     }
  129.  
  130.     set option(-before)      ""
  131.     set option(-after)       ""
  132.     set option(-at)          ""
  133.     set validOpts {-after -allowresize -at -before -expand -max -min -size}
  134.  
  135.     tixHandleOptions option $validOpts $args
  136.  
  137.     set data($name,size)        $option(-size)
  138.     set data($name,rsize)       $option(-size)
  139.     set data($name,min)         $option(-min)
  140.     set data($name,max)         $option(-max)
  141.     set data($name,allowresize) $option(-allowresize)
  142.     set data($name,expand)      $option(-expand)
  143.     set data($name,forgotten)   0
  144.  
  145.     if {$data($name,expand) < 0} {
  146.     set data($name,expand) 0
  147.     }
  148.  
  149.     # Step 2: Add the frame and the separator (if necessary)
  150.     #
  151.     if {![winfo exist $w.$name]} {
  152.     # need to check because the frame may have been "forget'ten"
  153.     #
  154.     frame $w.$name -bd $data(-paneborderwidth) -relief $data(-panerelief)
  155.     }
  156.  
  157.     if {$option(-at) != ""} {
  158.     set at [tixGetInt $option(-at)]
  159.     if {$at < 0} {
  160.         set at 0
  161.     }
  162.     } elseif {$option(-after) != ""} {
  163.     set index [lsearch -exact $data(items) $option(-after)]
  164.     if {$index == -1} {
  165.         error "Pane $option(-after) doesn't exists"
  166.     } else {
  167.         set at [incr index]
  168.     }
  169.     } elseif {$option(-before) != ""} {
  170.     set index [lsearch -exact $data(items) $option(-before)]
  171.     if {$index == -1} {
  172.         error "Pane $option(-before) doesn't exists"
  173.     }
  174.     set at $index
  175.     } else {
  176.     set at end
  177.     }
  178.  
  179.     set data(items) [linsert $data(items) $at $name]    
  180.     incr data(nItems)
  181.  
  182.     if {$data(nItems) > 1} {
  183.     tixPanedWindow:AddSeparator $w
  184.     }
  185.     set data(w:$name) $w.$name
  186.  
  187.     # Step 3: Add the new frame. Adjust the window later (do when idle)
  188.     #
  189.     tixManageGeometry $w.$name "tixPanedWindow:ClientGeomProc $w"
  190.     bind $w.$name <Configure> \
  191.     [list tixPanedWindow:ClientGeomProc $w "" $w.$name]
  192.  
  193.     tixPanedWindow:RepackWhenIdle $w
  194.  
  195.     return $w.$name
  196. }
  197.  
  198. proc tixPanedWindow:manage {w name args} {
  199.     upvar #0 $w data
  200.  
  201.     if {![winfo exists $w.$name]} {
  202.     error "Pane $name does not exist"
  203.     }
  204.     if {!$data($name,forgotten)} {
  205.     error "Pane $name is already managed"
  206.     }
  207.     tixMapWindow $data(w:$name)
  208.     eval tixPanedWindow:add $w [list $name] $args
  209. }
  210.  
  211. proc tixPanedWindow:forget {w name} {
  212.     upvar #0 $w data
  213.  
  214.     if {![winfo exists $w.$name]} {
  215.     error "Pane $name does not exist"
  216.     }
  217.     if $data($name,forgotten) {
  218.     # It has already been forgotten
  219.     #
  220.     return
  221.     }
  222.  
  223.     set items ""
  224.     foreach item $data(items) {
  225.     if {$item != $name} {
  226.         lappend items $item
  227.     }
  228.     }
  229.     set data(items) $items
  230.     incr data(nItems) -1
  231.  
  232.     set i $data(nItems)
  233.     if {$i > 0} {
  234.     destroy $data(btn,$i)
  235.     destroy $data(sep,$i)
  236.     unset data(btn,$i)
  237.     unset data(sep,$i)
  238.     }
  239.     set data($name,forgotten) 1
  240.  
  241.     tixUnmapWindow $w.$name
  242.  
  243.     tixPanedWindow:RepackWhenIdle $w
  244. }
  245.  
  246. proc tixPanedWindow:delete {w name} {
  247.     upvar #0 $w data
  248.  
  249.     if {![winfo exists $w.$name]} {
  250.     error "Pane $name does not exist"
  251.     }
  252.  
  253.  
  254.     if {!$data($name,forgotten)} {
  255.     set items ""
  256.     foreach item $data(items) {
  257.         if {$item != $name} {
  258.         lappend items $item
  259.         }
  260.     }
  261.     set data(items) $items
  262.     incr data(nItems) -1
  263.  
  264.     set i $data(nItems)
  265.     if {$i > 0} {
  266.         destroy $data(btn,$i)
  267.         destroy $data(sep,$i)
  268.         unset data(btn,$i)
  269.         unset data(sep,$i)
  270.     }
  271.     }
  272.     unset data($name,allowresize)
  273.     unset data($name,expand)
  274.     unset data($name,forgotten)
  275.     unset data($name,max)
  276.     unset data($name,min)
  277.     unset data($name,rsize)
  278.     unset data($name,size)
  279.     unset data(w:$name)
  280.     destroy $w.$name
  281.  
  282.     tixPanedWindow:RepackWhenIdle $w
  283. }
  284.  
  285. proc tixPanedWindow:paneconfigure {w name args} {
  286.     upvar #0 $w data
  287.  
  288.     if {![info exists data($name,size)]} {
  289.     error "pane \"$name\" does not exist in $w"
  290.     }
  291.  
  292.     set len [llength $args]
  293.  
  294.     if {$len == 0} {
  295.     set value [$data(w:$name) configure]
  296.     lappend value [list -allowresize "" "" "" $data($name,allowresize)]
  297.     lappend value [list -expand "" "" "" $data($name,expand)]
  298.     lappend value [list -max "" "" "" $data($name,max)]
  299.     lappend value [list -min "" "" "" $data($name,min)]
  300.     lappend value [list -size "" "" "" $data($name,size)]
  301.     return $value
  302.     }
  303.  
  304.     if {$len == 1} {
  305.     case [lindex $args 0] {
  306.         -allowresize {
  307.         return [list -allowresize "" "" "" $data($name,allowresize)]
  308.         }
  309.         -expand {
  310.         return [list -expand "" "" "" $data($name,expand)]
  311.         }
  312.         -min {
  313.         return [list -min "" "" "" $data($name,min)]
  314.         }
  315.         -max {
  316.         return [list -max "" "" "" $data($name,max)]
  317.         }
  318.         -size {
  319.         return [list -size "" "" "" $data($name,size)]
  320.         }
  321.         default {
  322.         return [$data(w:$name) configure [lindex $args 0]]
  323.         }
  324.     }
  325.     }
  326.  
  327.     # By default handle each of the options
  328.     #
  329.     set option(-allowresize) $data($name,allowresize)
  330.     set option(-expand)      $data($name,expand)
  331.     set option(-min)         $data($name,min)
  332.     set option(-max)         $data($name,max)
  333.     set option(-size)        $data($name,size)
  334.  
  335.     tixHandleOptions -nounknown option {-allowresize -expand -max -min -size} \
  336.     $args
  337.  
  338.     #
  339.     # the widget options
  340.     set new_args ""
  341.     tixForEach {flag value} $args {
  342.     case $flag {
  343.         {-expand -min -max -allowresize -size} {
  344.  
  345.         }
  346.         default {
  347.         lappend new_args $flag
  348.         lappend new_args $value
  349.         }
  350.     }
  351.     }
  352.  
  353.     if {[llength $new_args] >= 2} {
  354.     eval $data(w:$name) configure $new_args
  355.     }
  356.  
  357.     #
  358.     # The add-on options
  359.     set data($name,allowresize) $option(-allowresize)
  360.     set data($name,expand)      $option(-expand)
  361.     set data($name,max)         $option(-max)
  362.     set data($name,min)         $option(-min)
  363.     set data($name,rsize)       $option(-size)
  364.     set data($name,size)        $option(-size)
  365.  
  366.     # 
  367.     # Integrity check
  368.     if {$data($name,expand) < 0} {
  369.     set data($name,expand) 0
  370.     }
  371.     if {$data($name,size) < $data($name,min)} {
  372.     set data($name,size) $data($name,min)
  373.     }
  374.     if {$data($name,size) > $data($name,max)} {
  375.     set data($name,size) $data($name,max)
  376.     }
  377.  
  378.     tixPanedWindow:RepackWhenIdle $w
  379.     return ""
  380. }
  381.  
  382. proc tixPanedWindow:panecget {w name option} {
  383.     upvar #0 $w data
  384.  
  385.     if {![info exists data($name,size)]} {
  386.     error "pane \"$name\" does not exist in $w"
  387.     }
  388.  
  389.     case $option {
  390.     {-min -max -allowresize -size} {
  391.         regsub \\\- $option "" option
  392.         return "$data($name,$option)"
  393.     }
  394.     default {
  395.         return [$data(w:$name) cget $option]
  396.     }
  397.     }
  398. }
  399.  
  400. # return the name of all panes
  401. proc tixPanedWindow:panes {w} {
  402.     upvar #0 $w data
  403.  
  404.     return $data(items)
  405. }
  406.  
  407. # set the size of a pane, specifying which direction it should
  408. # grow/shrink
  409. proc tixPanedWindow:setsize {w item size {direction next}} {
  410.     upvar #0 $w data
  411.  
  412.     set posn [lsearch $data(items) $item]
  413.     if {$posn == -1} {
  414.     error "pane \"$item\" does not exist"
  415.     }
  416.  
  417.     set diff [expr $size - $data($item,size)]
  418.     if {$diff == 0} {
  419.     return
  420.     }
  421.  
  422.     if {$posn == 0 && $direction == "prev"} {
  423.     set direction next
  424.     }
  425.     if {$posn == [expr $data(nItems)-1] && $direction == "next"} {
  426.     set direction prev
  427.     }
  428.  
  429.     if {$data(-orientation) == "vertical"} {
  430.         set rx [winfo rooty $data(w:$item)]
  431.     } else {
  432.         set rx [winfo rootx $data(w:$item)]
  433.     }
  434.     if {$direction == "prev"} {
  435.     set rx [expr $rx - $diff]
  436.     } elseif {$data(-orientation) == "vertical"} {
  437.     set rx [expr $rx + [winfo height $data(w:$item)] + $diff]
  438.     incr posn
  439.     } else {
  440.     set rx [expr $rx + [winfo width $data(w:$item)] + $diff]
  441.     incr posn
  442.     }
  443.  
  444.     # Set up the panedwin in a proper state
  445.     #
  446.     tixPanedWindow:BtnDown $w $posn 1
  447.     tixPanedWindow:BtnMove $w $posn $rx 1
  448.     tixPanedWindow:BtnUp $w $posn 1
  449.  
  450.     return $data(items)
  451. }
  452.  
  453. #----------------------------------------------------------------------
  454. # PrivateMethods:
  455. #----------------------------------------------------------------------
  456.  
  457. proc tixPanedWindow:AddSeparator {w} {
  458.     global tcl_platform
  459.  
  460.     upvar #0 $w data
  461.  
  462.     set n [expr $data(nItems)-1]
  463.  
  464.     # CYGNUS: On Windows, use relief ridge and a thicker line.
  465.     if {$tcl_platform(platform) == "windows"} then {
  466.       set relief "ridge"
  467.       set thickness 4
  468.     } else {
  469.       set relief "sunken"
  470.       set thickness 2
  471.     }
  472.     if {$data(-orientation) == "vertical"} {
  473.     set data(sep,$n) [frame $w.sep$n -relief $relief \
  474.         -bd 1 -height $thickness -width 10000 -bg $data(-separatorbg)]
  475.     } else {
  476.     set data(sep,$n) [frame $w.sep$n -relief $relief \
  477.         -bd 1 -width $thickness -height 10000 -bg $data(-separatorbg)]
  478.     }
  479.  
  480.     set data(btn,$n) [frame $w.btn$n -relief raised \
  481.     -bd 1 -width 9 -height 9 \
  482.     -bg $data(-handlebg)]
  483.  
  484.     if {$data(-orientation) == "vertical"} {
  485.     set cursor sb_v_double_arrow
  486.     } else {
  487.     set cursor sb_h_double_arrow
  488.     }
  489.     $data(sep,$n) config -cursor $cursor
  490.     $data(btn,$n) config -cursor $cursor
  491.  
  492.     foreach wid "$data(btn,$n) $data(sep,$n)" {
  493.     bind $wid \
  494.         <ButtonPress-1>   "tixPanedWindow:BtnDown $w $n"
  495.     bind $wid \
  496.         <ButtonRelease-1> "tixPanedWindow:BtnUp   $w $n"
  497.     bind $wid \
  498.         <Any-Enter>       "tixPanedWindow:HighlightBtn $w $n"
  499.     bind $wid \
  500.         <Any-Leave>       "tixPanedWindow:DeHighlightBtn $w $n"
  501.     }
  502.  
  503.     if {$data(-orientation) == "vertical"} {
  504.     bind  $data(btn,$n) <B1-Motion> \
  505.         "tixPanedWindow:BtnMove $w $n %Y"
  506.     } else {
  507.     bind  $data(btn,$n) <B1-Motion> \
  508.         "tixPanedWindow:BtnMove $w $n %X"
  509.     }
  510.  
  511.     if {$data(-orientation) == "vertical"} {
  512. #    place $data(btn,$n) -relx 0.90 -y [expr "$data(totalsize)-5"]
  513. #    place $data(sep,$n) -x 0 -y [expr "$data(totalsize)-1"] -relwidth 1
  514.     } else {
  515. #    place $data(btn,$n) -rely 0.90 -x [expr "$data(totalsize)-5"]
  516. #    place $data(sep,$n) -y 0 -x [expr "$data(totalsize)-1"] -relheight 1
  517.     }
  518. }
  519.  
  520. proc tixPanedWindow:BtnDown {w item {fake 0}} {
  521.     upvar #0 $w data
  522.  
  523.     if {$data(-orientation) == "vertical"} {
  524.     set spec -height
  525.     } else {
  526.     set spec -width
  527.     }
  528.  
  529.     if {!$fake} {
  530.     for {set i 1} {$i < $data(nItems)} {incr i} {
  531.         $data(sep,$i) config -bg $data(-separatoractivebg) $spec 1
  532.     }
  533.     update idletasks
  534.     $data(btn,$item) config -relief sunken
  535.     }
  536.  
  537.     tixPanedWindow:GetMotionLimit $w $item $fake
  538.  
  539.     if {!$fake} {
  540.     grab -global $data(btn,$item)
  541.     }
  542.     set data(movePending) 0
  543. }
  544.  
  545. proc tixPanedWindow:Min2 {a b} {
  546.     if {$a < $b} {
  547.     return $a
  548.     } else {
  549.     return $b
  550.     }
  551. }
  552.  
  553. proc tixPanedWindow:GetMotionLimit {w item fake} {
  554.     upvar #0 $w data
  555.  
  556.     set curBefore 0
  557.     set minBefore 0
  558.     set maxBefore 0
  559.  
  560.     for {set i 0} {$i < $item} {incr i} {
  561.     set name [lindex $data(items) $i]
  562.     incr curBefore $data($name,size)
  563.     incr minBefore $data($name,min)
  564.     incr maxBefore $data($name,max)
  565.     }
  566.  
  567.     set curAfter 0
  568.     set minAfter 0
  569.     set maxAfter 0
  570.     while {$i < $data(nItems)} {
  571.     set name [lindex $data(items) $i]
  572.     incr curAfter $data($name,size)
  573.     incr minAfter $data($name,min)
  574.     incr maxAfter $data($name,max)
  575.     incr i
  576.     }
  577.  
  578.     set beforeToGo [tixPanedWindow:Min2 \
  579.         [expr "$curBefore-$minBefore"] [expr "$maxAfter-$curAfter"]]
  580.  
  581.     set afterToGo [tixPanedWindow:Min2 \
  582.         [expr "$curAfter-$minAfter"] [expr "$maxBefore-$curBefore"]]
  583.  
  584.     set data(beforeLimit) [expr "$curBefore-$beforeToGo"]
  585.     set data(afterLimit)  [expr "$curBefore+$afterToGo"]
  586.     set data(curSize)     $curBefore
  587.  
  588.     if {!$fake} {
  589.     tixPanedWindow:PlotHandles $w 1
  590.     }
  591. }
  592.  
  593. # Compress the motion so that update is quick even on slow machines
  594. #
  595. # rootp = root position (either rootx or rooty)
  596. proc tixPanedWindow:BtnMove {w item rootp {fake 0}} {
  597.     upvar #0 $w data
  598.  
  599.     set data(rootp) $rootp
  600.  
  601.     if {$fake} {
  602.     tixPanedWindow:BtnMoveCompressed $w $item $fake
  603.     } else {
  604.     if {$data(movePending) == 0} {
  605.         after 2 tixPanedWindow:BtnMoveCompressed $w $item
  606.         set data(movePending) 1
  607.     }
  608.     } 
  609. }
  610.  
  611. proc tixPanedWindow:BtnMoveCompressed {w item {fake 0}} {
  612.     if {![winfo exists $w]} {
  613.     return
  614.     }
  615.  
  616.     upvar #0 $w data
  617.  
  618.     if {$data(-orientation) == "vertical"} {
  619.     set p [expr $data(rootp)-[winfo rooty $w]]
  620.     } else {
  621.     set p [expr $data(rootp)-[winfo rootx $w]]
  622.     }
  623.  
  624.     if {$p == $data(curSize)} {
  625.     set data(movePending) 0
  626.     return
  627.     }
  628.  
  629.     if {$p < $data(beforeLimit)} {
  630.     set p $data(beforeLimit)
  631.     }
  632.     if {$p >= $data(afterLimit)} {
  633.     set p $data(afterLimit)
  634.     }
  635.     tixPanedWindow:CalculateChange $w $item $p $fake
  636.  
  637.     if {!$fake} {
  638.     # Force the redraw to happen
  639.     #
  640.     update idletasks
  641.     }
  642.     set data(movePending) 0
  643. }
  644.  
  645. # Calculate the change in response to mouse motions
  646. #
  647. proc tixPanedWindow:CalculateChange {w item p {fake 0}} {
  648.     upvar #0 $w data
  649.  
  650.     if {$p < $data(curSize)} {
  651.     tixPanedWindow:MoveBefore $w $item $p
  652.     } elseif {$p > $data(curSize)} {
  653.     tixPanedWindow:MoveAfter $w $item $p
  654.     }
  655.  
  656.     if {!$fake} {
  657.     tixPanedWindow:PlotHandles $w 1
  658.     }
  659. }
  660.  
  661. proc tixPanedWindow:MoveBefore {w item p} {
  662.     upvar #0 $w data
  663.  
  664.     set n [expr "$data(curSize)-$p"]
  665.  
  666.     # Shrink the frames before
  667.     #
  668.     set from [expr $item-1]
  669.     set to   0
  670.     tixPanedWindow:Iterate $w $from $to tixPanedWindow:Shrink $n
  671.  
  672.     # Adjust the frames after
  673.     #
  674.     set from $item
  675.     set to   [expr "$data(nItems)-1"]
  676.     tixPanedWindow:Iterate $w $from $to tixPanedWindow:Grow $n
  677.  
  678.     set data(curSize) $p
  679. }
  680.  
  681. proc tixPanedWindow:MoveAfter {w item p} {
  682.     upvar #0 $w data
  683.  
  684.     set n    [expr "$p-$data(curSize)"]
  685.  
  686.     # Shrink the frames after
  687.     #
  688.     set from $item
  689.     set to   [expr "$data(nItems)-1"]
  690.     tixPanedWindow:Iterate $w $from $to tixPanedWindow:Shrink $n
  691.  
  692.     # Graw the frame before
  693.     #
  694.     set from [expr $item-1]
  695.     set to   0
  696.     tixPanedWindow:Iterate $w $from $to tixPanedWindow:Grow $n
  697.  
  698.     set data(curSize) $p
  699. }
  700.  
  701. proc tixPanedWindow:CancleLines {w} {
  702.     upvar #0 $w data
  703.  
  704.     if {[info exists data(lines)]} {
  705.     foreach line $data(lines) {
  706.         set x1 [lindex $line 0]
  707.         set y1 [lindex $line 1]
  708.         set x2 [lindex $line 2]
  709.         set y2 [lindex $line 3]
  710.  
  711.         tixTmpLine $x1 $y1 $x2 $y2 $w
  712.     }
  713.  
  714.     catch {unset data(lines)}
  715.     }
  716. }
  717.  
  718. proc tixPanedWindow:PlotHandles {w transient} {
  719.     global tcl_platform
  720.  
  721.     upvar #0 $w data
  722.  
  723.     set totalsize 0
  724.     set i 0
  725.  
  726.     if {$data(-orientation) == "vertical"} {
  727.     set btnp [expr [winfo width $w]-13]
  728.     } else {
  729.     set h [winfo height $w]
  730.     if {$h > 18} {
  731.         set btnp 9
  732.     } else {
  733.         set btnp [expr $h-9]
  734.     }
  735.     }
  736.  
  737.     set firstpane [lindex $data(items) 0]
  738.     set totalsize $data($firstpane,size)
  739.  
  740.     if {$transient} {
  741.     tixPanedWindow:CancleLines $w
  742.     set data(lines) ""
  743.     }
  744.  
  745.     for {set i 1} {$i < $data(nItems)} {incr i} {
  746.     if {! $transient} {
  747.         if {$data(-orientation) == "vertical"} {
  748.         place $data(btn,$i) -x $btnp -y [expr "$totalsize-4"]
  749.         place $data(sep,$i) -x 0 -y [expr "$totalsize-1"] -relwidth 1
  750.         } else {
  751.         place $data(btn,$i) -y $btnp -x [expr "$totalsize-5"]
  752.         place $data(sep,$i) -y 0 -x [expr "$totalsize-1"] -relheight 1
  753.         }
  754.     } else {
  755.         if {$data(-orientation) == "vertical"} {
  756.         set x1 [winfo rootx $w]
  757.         set x2 [expr $x1 + [winfo width $w]]
  758.         set y  [expr $totalsize-1+[winfo rooty $w]]
  759.  
  760.         tixTmpLine $x1 $y $x2 $y $w
  761.         lappend data(lines) [list $x1 $y $x2 $y]
  762.         } else {
  763.         set y1 [winfo rooty $w]
  764.         set y2 [expr $y1 + [winfo height $w]]
  765.         set x  [expr $totalsize-1+[winfo rootx $w]]
  766.  
  767.         tixTmpLine $x $y1 $x $y2 $w
  768.         lappend data(lines) [list $x $y1 $x $y2]
  769.         }
  770.     }
  771.  
  772.     set name [lindex $data(items) $i]
  773.     incr totalsize $data($name,size)
  774.     }
  775. }
  776.  
  777. proc tixPanedWindow:BtnUp {w item {fake 0}} {
  778.     upvar #0 $w data
  779.  
  780.     if {!$fake} {
  781.     tixPanedWindow:CancleLines $w
  782.     }
  783.  
  784.     tixPanedWindow:UpdateSizes $w
  785.  
  786.     if {!$fake} {
  787.     $data(btn,$item) config -relief raised
  788.     grab release $data(btn,$item)
  789.     }
  790. }
  791.  
  792.  
  793. proc tixPanedWindow:HighlightBtn {w item} {
  794.     upvar #0 $w data
  795.  
  796.     $data(btn,$item) config -background $data(-handleactivebg)
  797. }
  798.  
  799. proc tixPanedWindow:DeHighlightBtn {w item} {
  800.     upvar #0 $w data
  801.  
  802.     $data(btn,$item) config -background $data(-handlebg)
  803. }
  804.  
  805. #----------------------------------------------------------------------
  806. #
  807. #
  808. # Geometry management routines
  809. #
  810. #
  811. #----------------------------------------------------------------------
  812.  
  813. # update the sizes of each pane according to the data($name,size) variables
  814. #
  815. proc tixPanedWindow:UpdateSizes {w} {
  816.     global tcl_platform
  817.  
  818.     upvar #0 $w data
  819.  
  820.     set data(totalsize) 0
  821.  
  822.     set mw [winfo width  $w]
  823.     set mh [winfo height $w]
  824.  
  825.     for {set i 0} {$i < $data(nItems)} {incr i} {
  826.     set name [lindex $data(items) $i]
  827.  
  828.     if {$data($name,size) > 0} {
  829.         if {$data(-orientation) == "vertical"} {
  830.         tixMoveResizeWindow $w.$name 0 $data(totalsize) \
  831.             $mw $data($name,size)
  832.         tixMapWindow $w.$name
  833.         raise $w.$name
  834.         } else {
  835.         tixMoveResizeWindow $w.$name $data(totalsize) 0 \
  836.             $data($name,size) $mh
  837.         tixMapWindow $w.$name
  838.         raise $w.$name
  839.         }
  840.     } else {
  841.         tixUnmapWindow $w.$name
  842.     }
  843.     incr data(totalsize) $data($name,size)
  844.     }
  845.  
  846.     # Reset the color and width of the separator
  847.     #
  848.     if {$data(-orientation) == "vertical"} {
  849.     set spec -height
  850.     } else {
  851.     set spec -width
  852.     }
  853.  
  854.     # CYGNUS: On Windows, use a thicker line.
  855.     if {$tcl_platform(platform) == "windows"} then {
  856.     set thickness 4
  857.     } else {
  858.     set thickness 2
  859.     }
  860.  
  861.     for {set i 1} {$i < $data(nItems)} {incr i} {
  862.     $data(sep,$i) config -bg $data(-separatorbg) $spec $thickness
  863.     raise $data(sep,$i)
  864.     raise $data(btn,$i)
  865.     }
  866.  
  867.  
  868.     # Invoke the callback command
  869.     #
  870.     if {$data(-command) != ""} {
  871.     set sizes ""
  872.     foreach item $data(items) {
  873.         lappend sizes $data($item,size)
  874.     }
  875.     set bind(specs) ""
  876.     tixEvalCmdBinding $w $data(-command) bind [list $sizes]
  877.     }
  878. }
  879.  
  880. proc tixPanedWindow:GetNaturalSizes {w} {
  881.     upvar #0 $w data
  882.  
  883.     set data(totalsize) 0
  884.     set totalreq 0
  885.  
  886.     if {$data(-orientation) == "vertical"} {
  887.     set majorspec height
  888.     set minorspec width
  889.     } else {
  890.     set majorspec width
  891.     set minorspec height
  892.     }
  893.  
  894.     set minorsize 0
  895.     foreach name $data(items) {
  896.     if {[winfo manager $w.$name] != "tixGeometry"} {
  897.         error "Geometry management error: pane \"$w.$name\" cannot be managed by \"[winfo manager $w.$name]\"\nhint: delete the line \"[winfo manager $w.$name] $w.$name ...\" from your program"
  898.     }
  899.  
  900.     # set the minor size
  901.     #
  902.     set req_minor [winfo req$minorspec $w.$name]
  903.  
  904.     if {$req_minor > $minorsize} {
  905.         set minorsize $req_minor
  906.     }
  907.  
  908.     # Check the natural size against the max, min requirements.
  909.     # Change the natural size if necessary
  910.     #
  911.     if {$data($name,size) <= 1} {
  912.         set data($name,size) [winfo req$majorspec $w.$name]
  913.     }
  914.  
  915.     if {$data($name,size) > 1} {
  916.         # If we get zero maybe the widget was not initialized yet ...
  917.         #
  918.         # %% hazard : what if the window is really 1x1?
  919.         #
  920.         if {$data($name,size) < $data($name,min)} {
  921.         set data($name,size) $data($name,min)
  922.         }
  923.         if {$data($name,size) > $data($name,max)} {
  924.         set data($name,size) $data($name,max)
  925.         }
  926.     }
  927.  
  928.     # kludge: because a frame always returns req size of {1,1} before
  929.     # the packer processes it, we do the following to mark the
  930.     # pane as "size unknown"
  931.     #
  932. #    if {$data($name,size) == 1 && ![winfo ismapped $w.$name]} {
  933. #        set data($name,size) 0
  934. #    }
  935.  
  936.     # Add up the total size
  937.     #
  938.     incr data(totalsize) $data($name,size)
  939.  
  940.     # Find out the request size
  941.     #
  942.     if {$data($name,rsize) == 0} {
  943.         set rsize [winfo req$majorspec $w.$name]
  944.     } else {
  945.         set rsize $data($name,rsize)
  946.     }
  947.  
  948.     if {$rsize < $data($name,min)} {
  949.         set rsize $data($name,min)
  950.     }
  951.     if {$rsize > $data($name,max)} {
  952.         set rsize $data($name,max)
  953.     }
  954.  
  955.     incr totalreq $rsize
  956.     }
  957.  
  958.     if {$data(-orientation) == "vertical"} {
  959.     return [list $minorsize $totalreq]
  960.     } else {
  961.     return [list $totalreq $minorsize]
  962.     }
  963. }
  964.  
  965. #--------------------------------------------------
  966. # Handling resize
  967. #--------------------------------------------------
  968. proc tixPanedWindow:ClientGeomProc {w type client} {
  969.     tixPanedWindow:RepackWhenIdle $w
  970. }
  971.  
  972. #
  973. # This monitor the sizes of the master window
  974. #
  975. proc tixPanedWindow:MasterGeomProc {w master} {
  976.     tixPanedWindow:RepackWhenIdle $w
  977. }
  978.  
  979. proc tixPanedWindow:RepackWhenIdle {w} {
  980.     if {![winfo exist $w]} {
  981.     return
  982.     }
  983.     upvar #0 $w data
  984.  
  985.     if {$data(repack) == 0} {
  986.     tixWidgetDoWhenIdle tixPanedWindow:Repack $w
  987.     set data(repack) 1
  988.     }
  989. }
  990.  
  991. #
  992. # This monitor the sizes of the master window
  993. #
  994. proc tixPanedWindow:Repack {w} {
  995.     upvar #0 $w data
  996.  
  997.     # Calculate the desired size of the master
  998.     #
  999.     set dim [tixPanedWindow:GetNaturalSizes $w]
  1000.  
  1001.     if {$data(-width) != 0} {
  1002.     set mreqw $data(-width)
  1003.     } else {
  1004.     set mreqw [lindex $dim 0]
  1005.     }
  1006.  
  1007.     if {$data(-height) != 0} {
  1008.     set mreqh $data(-height)
  1009.     } else {
  1010.     set mreqh [lindex $dim 1]
  1011.     }
  1012.  
  1013.     if !$data(-dynamicgeometry) {
  1014.     if {$mreqw < $data(maxReqW)} {
  1015.         set mreqw $data(maxReqW)
  1016.     }
  1017.     if {$mreqh < $data(maxReqH)} {
  1018.         set mreqh $data(maxReqH)
  1019.     }
  1020.     set data(maxReqW) $mreqw
  1021.     set data(maxReqH) $mreqh
  1022.     }
  1023.     if {$mreqw != [winfo reqwidth $w] || $mreqh != [winfo reqheight $w] } {
  1024.     if {![info exists data(counter)]} {
  1025.         set data(counter) 0
  1026.     }
  1027.     if {$data(counter) < 50} {
  1028.         incr data(counter)
  1029.         tixGeometryRequest $w $mreqw $mreqh
  1030.         tixWidgetDoWhenIdle tixPanedWindow:Repack $w
  1031.         set data(repack) 1
  1032.         return
  1033.     }
  1034.     }
  1035.  
  1036.     set data(counter) 0
  1037.  
  1038.     if {$data(nItems) == 0} {
  1039.     set data(repack) 0
  1040.     return
  1041.     }
  1042.  
  1043.     tixWidgetDoWhenIdle tixPanedWindow:DoRepack $w
  1044. }
  1045.  
  1046. proc tixPanedWindow:DoRepack {w} {
  1047.     upvar #0 $w data
  1048.  
  1049.     if {$data(-orientation) == "vertical"} {
  1050.     set newSize [winfo height $w]
  1051.     } else {
  1052.     set newSize [winfo width $w]
  1053.     }
  1054.  
  1055.     if {$newSize <= 1} {
  1056.     # Probably this window is too small to see anyway
  1057.     # %%Kludge: I don't know if this always work.
  1058.     #
  1059.     set data(repack) 0
  1060.     return
  1061.     }
  1062.  
  1063.     set totalExp 0
  1064.     foreach name $data(items) {
  1065.     set totalExp [expr $totalExp + $data($name,expand)]
  1066.     }
  1067.  
  1068.     if {$newSize > $data(totalsize)} {
  1069.     # Grow
  1070.     #
  1071.     set toGrow [expr "$newSize-$data(totalsize)"]
  1072.  
  1073.     set p [llength $data(items)]
  1074.     foreach name $data(items) {
  1075.         set toGrow [tixPanedWindow:xGrow $w $name $toGrow $totalExp $p]
  1076.         if {$toGrow > 0} {
  1077.         set totalExp [expr $totalExp-$data($name,expand)]
  1078.         incr p -1
  1079.         } else {
  1080.         break
  1081.         }
  1082.     }
  1083.     } else {
  1084.     # Shrink
  1085.     #
  1086.     set toShrink [expr "$data(totalsize)-$newSize"]
  1087.  
  1088.     set usedSize 0
  1089.     foreach name $data(items) {
  1090.         set toShrink [tixPanedWindow:xShrink $w $name $toShrink \
  1091.         $totalExp $newSize $usedSize]
  1092.         if {$toShrink > 0} {
  1093.         set totalExp [expr $totalExp-$data($name,expand)]
  1094.         incr usedSize $data($name,size)
  1095.         } else {
  1096.         break
  1097.         }
  1098.     }
  1099.     }
  1100.  
  1101.     tixPanedWindow:UpdateSizes $w
  1102.     tixPanedWindow:PlotHandles $w 0
  1103.  
  1104.     set data(repack) 0
  1105. }
  1106.  
  1107. #--------------------------------------------------
  1108. # Shrink and grow items
  1109. #--------------------------------------------------
  1110. # 
  1111. #   toGrow: how much free area to grow into
  1112. #        p: == 1 if $name is the last in the list of items
  1113. # totalExp: used to calculate the amount of the free area that this
  1114. #        window can grow into
  1115. #
  1116. proc tixPanedWindow:xGrow {w name toGrow totalExp p} {
  1117.     upvar #0 $w data
  1118.  
  1119.     if {$p == 1} {
  1120.     set canGrow $toGrow
  1121.     } else {
  1122.     if {$totalExp == 0} {
  1123.         set canGrow 0
  1124.     } else {
  1125.         set canGrow [expr int($toGrow * $data($name,expand) / $totalExp)]
  1126.     }
  1127.     }
  1128.  
  1129.     if {[expr $canGrow + $data($name,size)] > $data($name,max)} {
  1130.     set canGrow [expr $data($name,max) - $data($name,size)]
  1131.     }
  1132.  
  1133.     incr data($name,size) $canGrow
  1134.     incr toGrow -$canGrow
  1135.  
  1136.     return $toGrow
  1137. }
  1138.  
  1139. proc tixPanedWindow:xShrink {w name toShrink totalExp newSize usedSize} {
  1140.     upvar #0 $w data
  1141.  
  1142.     if {$totalExp == 0} {
  1143.     set canShrink 0
  1144.     } else {
  1145.     set canShrink [expr int($toShrink * $data($name,expand) / $totalExp)]
  1146.     }
  1147.  
  1148.     if {[expr $data($name,size) - $canShrink] < $data($name,min)} {
  1149.     set canShrink [expr $data($name,size) -$data($name,min)]
  1150.     }
  1151.     if {[expr $usedSize + $data($name,size) - $canShrink] > $newSize} {
  1152.     set data($name,size) [expr $newSize - $usedSize]
  1153.     return 0
  1154.     } else {
  1155.     incr data($name,size) -$canShrink
  1156.     incr toShrink -$canShrink
  1157.  
  1158.     return $toShrink
  1159.     }
  1160. }
  1161.  
  1162. #--------------------------------------------------
  1163. # Shrink and grow items
  1164. #--------------------------------------------------
  1165. proc tixPanedWindow:Shrink {w name n} {
  1166.     upvar #0 $w data
  1167.  
  1168.     set canShrink [expr "$data($name,size) - $data($name,min)"]
  1169.  
  1170.     if {$canShrink > $n} {
  1171.     incr data($name,size) -$n
  1172.     return 0
  1173.     } elseif {$canShrink > 0} {
  1174.     set data($name,size) $data($name,min)
  1175.     incr n -$canShrink
  1176.     }
  1177.     return $n
  1178. }
  1179.  
  1180. proc tixPanedWindow:Grow {w name n} {
  1181.     upvar #0 $w data
  1182.  
  1183.     set canGrow [expr "$data($name,max) - $data($name,size)"]
  1184.  
  1185.     if {$canGrow > $n} {
  1186.     incr data($name,size) $n
  1187.     return 0
  1188.     } elseif {$canGrow > 0} {
  1189.     set data($name,size) $data($name,max)
  1190.     incr n -$canGrow
  1191.     }
  1192.  
  1193.     return $n
  1194. }
  1195.  
  1196. proc tixPanedWindow:Iterate {w from to proc n} {
  1197.     upvar #0 $w data
  1198.  
  1199.     if {$from <= $to} {
  1200.     for {set i $from} {$i <= $to} {incr i} {
  1201.         set n [$proc $w [lindex $data(items) $i] $n]
  1202.         if {$n == 0} {
  1203.         break
  1204.         }
  1205.     }
  1206.     } else {
  1207.     for {set i $from} {$i >= $to} {incr i -1} {
  1208.         set n [$proc $w [lindex $data(items) $i] $n]
  1209.         if {$n == 0} {
  1210.         break
  1211.         }
  1212.     }
  1213.     }
  1214. }
  1215.